home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / dejagnu.lha / dejagnu-1.0.1 / tcl / tests / trace.test < prev    next >
Text File  |  1992-11-06  |  20KB  |  716 lines
  1. # Commands covered:  trace
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright 1991 Regents of the University of California
  8. # Permission to use, copy, modify, and distribute this
  9. # software and its documentation for any purpose and without
  10. # fee is hereby granted, provided that this copyright notice
  11. # appears in all copies.  The University of California makes no
  12. # representations about the suitability of this software for any
  13. # purpose.  It is provided "as is" without express or implied
  14. # warranty.
  15. #
  16. # $Header: /user6/ouster/tcl/tests/RCS/trace.test,v 1.14 92/05/07 09:31:09 ouster Exp $ (Berkeley)
  17.  
  18. if {[string compare test [info procs test]] == 1} then {source defs}
  19.  
  20. proc traceScalar {name1 name2 op} {
  21.     global info
  22.     set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg]
  23. }
  24. proc traceArray {name1 name2 op} {
  25.     global info
  26.     set info [list $name1 $name2 $op [catch {uplevel set [set name1]($name2)} msg] $msg]
  27. }
  28. proc traceProc {name1 name2 op} {
  29.     global info
  30.     set info [concat $info [list $name1 $name2 $op]]
  31. }
  32. proc traceTag {tag args} {
  33.     global info
  34.     set info [concat $info $tag]
  35. }
  36. proc traceError {args} {
  37.     error error
  38. }
  39. proc traceCheck {cmd args} {
  40.     global info
  41.     set info [list [catch $cmd msg] $msg]
  42. }
  43.  
  44. # Read-tracing on variables
  45.  
  46. test trace-1.1 {trace variable reads} {
  47.     catch {unset x}
  48.     set info {}
  49.     trace var x r traceScalar
  50.     list [catch {set x} msg] $msg $info
  51. } {1 {can't read "x": no such variable} {x {} r 1 {can't read "x": no such variable}}}
  52. test trace-1.2 {trace variable reads} {
  53.     catch {unset x}
  54.     set x 123
  55.     set info {}
  56.     trace var x r traceScalar
  57.     list [catch {set x} msg] $msg $info
  58. } {0 123 {x {} r 0 123}}
  59. test trace-1.3 {trace variable reads} {
  60.     catch {unset x}
  61.     set info {}
  62.     trace var x r traceScalar
  63.     set x 123
  64.     set info
  65. } {}
  66. test trace-1.4 {trace array element reads} {
  67.     catch {unset x}
  68.     set info {}
  69.     trace var x(2) r traceArray
  70.     list [catch {set x(2)} msg] $msg $info
  71. } {1 {can't read "x(2)": no such variable} {x 2 r 1 {can't read "x(2)": no such variable}}}
  72. test trace-1.5 {trace array element reads} {
  73.     catch {unset x}
  74.     set x(2) zzz
  75.     set info {}
  76.     trace var x(2) r traceArray
  77.     list [catch {set x(2)} msg] $msg $info
  78. } {0 zzz {x 2 r 0 zzz}}
  79. test trace-1.6 {trace reads on whole arrays} {
  80.     catch {unset x}
  81.     set info {}
  82.     trace var x r traceArray
  83.     list [catch {set x(2)} msg] $msg $info
  84. } {1 {can't read "x(2)": no such variable} {}}
  85. test trace-1.7 {trace reads on whole arrays} {
  86.     catch {unset x}
  87.     set x(2) zzz
  88.     set info {}
  89.     trace var x r traceArray
  90.     list [catch {set x(2)} msg] $msg $info
  91. } {0 zzz {x 2 r 0 zzz}}
  92. test trace-1.8 {trace variable reads} {
  93.     catch {unset x}
  94.     set x 444
  95.     set info {}
  96.     trace var x r traceScalar
  97.     unset x
  98.     set info
  99. } {}
  100.  
  101. # Basic write-tracing on variables
  102.  
  103. test trace-2.1 {trace variable writes} {
  104.     catch {unset x}
  105.     set info {}
  106.     trace var x w traceScalar
  107.     set x 123
  108.     set info
  109. } {x {} w 0 123}
  110. test trace-2.2 {trace writes to array elements} {
  111.     catch {unset x}
  112.     set info {}
  113.     trace var x(33) w traceArray
  114.     set x(33) 444
  115.     set info
  116. } {x 33 w 0 444}
  117. test trace-2.3 {trace writes on whole arrays} {
  118.     catch {unset x}
  119.     set info {}
  120.     trace var x w traceArray
  121.     set x(abc) qq
  122.     set info
  123. } {x abc w 0 qq}
  124. test trace-2.4 {trace variable writes} {
  125.     catch {unset x}
  126.     set x 1234
  127.     set info {}
  128.     trace var x w traceScalar
  129.     set x
  130.     set info
  131. } {}
  132. test trace-2.5 {trace variable writes} {
  133.     catch {unset x}
  134.     set x 1234
  135.     set info {}
  136.     trace var x w traceScalar
  137.     unset x
  138.     set info
  139. } {}
  140.  
  141. # Basic unset-tracing on variables
  142.  
  143. test trace-3.1 {trace variable unsets} {
  144.     catch {unset x}
  145.     set info {}
  146.     trace var x u traceScalar
  147.     catch {unset x}
  148.     set info
  149. } {x {} u 1 {can't read "x": no such variable}}
  150. test trace-3.2 {variable mustn't exist during unset trace} {
  151.     catch {unset x}
  152.     set x 1234
  153.     set info {}
  154.     trace var x u traceScalar
  155.     unset x
  156.     set info
  157. } {x {} u 1 {can't read "x": no such variable}}
  158. test trace-3.3 {unset traces mustn't be called during reads and writes} {
  159.     catch {unset x}
  160.     set info {}
  161.     trace var x u traceScalar
  162.     set x 44
  163.     set x
  164.     set info
  165. } {}
  166. test trace-3.4 {trace unsets on array elements} {
  167.     catch {unset x}
  168.     set x(0) 18
  169.     set info {}
  170.     trace var x(1) u traceArray
  171.     catch {unset x(1)}
  172.     set info
  173. } {x 1 u 1 {can't read "x(1)": no such element in array}}
  174. test trace-3.5 {trace unsets on array elements} {
  175.     catch {unset x}
  176.     set x(1) 18
  177.     set info {}
  178.     trace var x(1) u traceArray
  179.     unset x(1)
  180.     set info
  181. } {x 1 u 1 {can't read "x(1)": no such element in array}}
  182. test trace-3.6 {trace unsets on array elements} {
  183.     catch {unset x}
  184.     set x(1) 18
  185.     set info {}
  186.     trace var x(1) u traceArray
  187.     unset x
  188.     set info
  189. } {x 1 u 1 {can't read "x(1)": no such variable}}
  190. test trace-3.7 {trace unsets on whole arrays} {
  191.     catch {unset x}
  192.     set x(1) 18
  193.     set info {}
  194.     trace var x u traceProc
  195.     catch {unset x(0)}
  196.     set info
  197. } {}
  198. test trace-3.8 {trace unsets on whole arrays} {
  199.     catch {unset x}
  200.     set x(1) 18
  201.     set info {}
  202.     trace var x u traceProc
  203.     unset x(1)
  204.     set info
  205. } {x 1 u}
  206. test trace-3.9 {trace unsets on whole arrays} {
  207.     catch {unset x}
  208.     set x(1) 18
  209.     set info {}
  210.     trace var x u traceProc
  211.     unset x
  212.     set info
  213. } {x {} u}
  214.  
  215. # Trace multiple trace types at once.
  216.  
  217. test trace-4.1 {multiple ops traced at once} {
  218.     catch {unset x}
  219.     set info {}
  220.     trace var x rwu traceProc
  221.     catch {set x}
  222.     set x 22
  223.     set x
  224.     set x 33
  225.     unset x
  226.     set info
  227. } {x {} r x {} w x {} r x {} w x {} u}
  228. test trace-4.2 {multiple ops traced on array element} {
  229.     catch {unset x}
  230.     set info {}
  231.     trace var x(0) rwu traceProc
  232.     catch {set x(0)}
  233.     set x(0) 22
  234.     set x(0)
  235.     set x(0) 33
  236.     unset x(0)
  237.     unset x
  238.     set info
  239. } {x 0 r x 0 w x 0 r x 0 w x 0 u}
  240. test trace-4.3 {multiple ops traced on whole array} {
  241.     catch {unset x}
  242.     set info {}
  243.     trace var x rwu traceProc
  244.     catch {set x(0)}
  245.     set x(0) 22
  246.     set x(0)
  247.     set x(0) 33
  248.     unset x(0)
  249.     unset x
  250.     set info
  251. } {x 0 w x 0 r x 0 w x 0 u x {} u}
  252.  
  253. # Check order of invocation of traces
  254.  
  255. test trace-5.1 {order of invocation of traces} {
  256.     catch {unset x}
  257.     set info {}
  258.     trace var x r "traceTag 1"
  259.     trace var x r "traceTag 2"
  260.     trace var x r "traceTag 3"
  261.     catch {set x}
  262.     set x 22
  263.     set x
  264.     set info
  265. } {3 2 1 3 2 1}
  266. test trace-5.2 {order of invocation of traces} {
  267.     catch {unset x}
  268.     set x(0) 44
  269.     set info {}
  270.     trace var x(0) r "traceTag 1"
  271.     trace var x(0) r "traceTag 2"
  272.     trace var x(0) r "traceTag 3"
  273.     set x(0)
  274.     set info
  275. } {3 2 1}
  276. test trace-5.3 {order of invocation of traces} {
  277.     catch {unset x}
  278.     set x(0) 44
  279.     set info {}
  280.     trace var x(0) r "traceTag 1"
  281.     trace var x r "traceTag A1"
  282.     trace var x(0) r "traceTag 2"
  283.     trace var x r "traceTag A2"
  284.     trace var x(0) r "traceTag 3"
  285.     trace var x r "traceTag A3"
  286.     set x(0)
  287.     set info
  288. } {A3 A2 A1 3 2 1}
  289.  
  290. # Check effects of errors in trace procedures
  291.  
  292. test trace-6.1 {error returns from traces} {
  293.     catch {unset x}
  294.     set x 123
  295.     set info {}
  296.     trace var x r "traceTag 1"
  297.     trace var x r error
  298.     list [catch {set x} msg] $msg $info
  299. } {1 {can't read "x": access disallowed by trace command} {}}
  300. test trace-6.2 {error returns from traces} {
  301.     catch {unset x}
  302.     set x 123
  303.     set info {}
  304.     trace var x w "traceTag 1"
  305.     trace var x w error
  306.     list [catch {set x 44} msg] $msg $info
  307. } {1 {can't set "x": access disallowed by trace command} {}}
  308. test trace-6.3 {error returns from traces} {
  309.     catch {unset x}
  310.     set x 123
  311.     set info {}
  312.     trace var x u "traceTag 1"
  313.     trace var x u error
  314.     list [catch {unset x} msg] $msg $info
  315. } {0 {} 1}
  316. test trace-6.4 {error returns from traces} {
  317.     catch {unset x}
  318.     set x(0) 123
  319.     set info {}
  320.     trace var x(0) r "traceTag 1"
  321.     trace var x r "traceTag 2"
  322.     trace var x r error
  323.     trace var x r "traceTag 3"
  324.     list [catch {set x(0)} msg] $msg $info
  325. } {1 {can't read "x(0)": access disallowed by trace command} 3}
  326.  
  327. # Check to see that variables are expunged before trace
  328. # procedures are invoked, so trace procedure can even manipulate
  329. # a new copy of the variables.
  330.  
  331. test trace-7.1 {be sure variable is unset before trace is called} {
  332.     catch {unset x}
  333.     set x 33
  334.     set info {}
  335.     trace var x u {traceCheck {uplevel set x}}
  336.     unset x
  337.     set info
  338. } {1 {can't read "x": no such variable}}
  339. test trace-7.2 {be sure variable is unset before trace is called} {
  340.     catch {unset x}
  341.     set x 33
  342.     set info {}
  343.     trace var x u {traceCheck {uplevel set x 22}}
  344.     unset x
  345.     concat $info [list [catch {set x} msg] $msg]
  346. } {0 22 0 22}
  347. test trace-7.3 {be sure traces are cleared before unset trace called} {
  348.     catch {unset x}
  349.     set x 33
  350.     set info {}
  351.     trace var x u {traceCheck {uplevel trace vinfo x}}
  352.     unset x
  353.     set info
  354. } {0 {}}
  355. test trace-7.4 {set new trace during unset trace} {
  356.     catch {unset x}
  357.     set x 33
  358.     set info {}
  359.     trace var x u {traceCheck {global x; trace var x u traceProc}}
  360.     unset x
  361.     concat $info [trace vinfo x]
  362. } {0 {} {u traceProc}}
  363.  
  364. test trace-8.1 {make sure array elements are unset before traces are called} {
  365.     catch {unset x}
  366.     set x(0) 33
  367.     set info {}
  368.     trace var x(0) u {traceCheck {uplevel set x(0)}}
  369.     unset x(0)
  370.     set info
  371. } {1 {can't read "x(0)": no such element in array}}
  372. test trace-8.2 {make sure array elements are unset before traces are called} {
  373.     catch {unset x}
  374.     set x(0) 33
  375.     set info {}
  376.     trace var x(0) u {traceCheck {uplevel set x(0) zzz}}
  377.     unset x(0)
  378.     concat $info [list [catch {set x(0)} msg] $msg]
  379. } {0 zzz 0 zzz}
  380. test trace-8.3 {array elements are unset before traces are called} {
  381.     catch {unset x}
  382.     set x(0) 33
  383.     set info {}
  384.     trace var x(0) u {traceCheck {global x; trace vinfo x(0)}}
  385.     unset x(0)
  386.     set info
  387. } {0 {}}
  388. test trace-8.4 {set new array element trace during unset trace} {
  389.     catch {unset x}
  390.     set x(0) 33
  391.     set info {}
  392.     trace var x(0) u {traceCheck {uplevel {trace variable x(0) r {}}}}
  393.     catch {unset x(0)}
  394.     concat $info [trace vinfo x(0)]
  395. } {0 {} {r {}}}
  396.  
  397. test trace-9.1 {make sure arrays are unset before traces are called} {
  398.     catch {unset x}
  399.     set x(0) 33
  400.     set info {}
  401.     trace var x u {traceCheck {uplevel set x(0)}}
  402.     unset x
  403.     set info
  404. } {1 {can't read "x(0)": no such variable}}
  405. test trace-9.2 {make sure arrays are unset before traces are called} {
  406.     catch {unset x}
  407.     set x(y) 33
  408.     set info {}
  409.     trace var x u {traceCheck {uplevel set x(y) 22}}
  410.     unset x
  411.     concat $info [list [catch {set x(y)} msg] $msg]
  412. } {0 22 0 22}
  413. test trace-9.3 {make sure arrays are unset before traces are called} {
  414.     catch {unset x}
  415.     set x(y) 33
  416.     set info {}
  417.     trace var x u {traceCheck {uplevel array names x}}
  418.     unset x
  419.     set info
  420. } {1 {"x" isn't an array}}
  421. test trace-9.4 {make sure arrays are unset before traces are called} {
  422.     catch {unset x}
  423.     set x(y) 33
  424.     set info {}
  425.     set cmd {traceCheck {uplevel {trace vinfo x}}}
  426.     trace var x u $cmd
  427.     unset x
  428.     set info
  429. } {0 {}}
  430. test trace-9.5 {set new array trace during unset trace} {
  431.     catch {unset x}
  432.     set x(y) 33
  433.     set info {}
  434.     trace var x u {traceCheck {global x; trace var x r {}}}
  435.     unset x
  436.     concat $info [trace vinfo x]
  437. } {0 {} {r {}}}
  438. test trace-9.6 {create scalar during array unset trace} {
  439.     catch {unset x}
  440.     set x(y) 33
  441.     set info {}
  442.     trace var x u {traceCheck {global x; set x 44}}
  443.     unset x
  444.     concat $info [list [catch {set x} msg] $msg]
  445. } {0 44 0 44}
  446.  
  447. # Check special conditions (e.g. errors) in Tcl_TraceVar2.
  448.  
  449. test trace-10.1 {creating array when setting variable traces} {
  450.     catch {unset x}
  451.     set info {}
  452.     trace var x(0) w traceProc
  453.     list [catch {set x 22} msg] $msg
  454. } {1 {can't set "x": variable is array}}
  455. test trace-10.2 {creating array when setting variable traces} {
  456.     catch {unset x}
  457.     set info {}
  458.     trace var x(0) w traceProc
  459.     list [catch {set x(0)} msg] $msg
  460. } {1 {can't read "x(0)": no such variable}}
  461. test trace-10.3 {creating array when setting variable traces} {
  462.     catch {unset x}
  463.     set info {}
  464.     trace var x(0) w traceProc
  465.     set x(0) 22
  466.     set info
  467. } {x 0 w}
  468. test trace-10.4 {creating variable when setting variable traces} {
  469.     catch {unset x}
  470.     set info {}
  471.     trace var x w traceProc
  472.     list [catch {set x} msg] $msg
  473. } {1 {can't read "x": no such variable}}
  474. test trace-10.5 {creating variable when setting variable traces} {
  475.     catch {unset x}
  476.     set info {}
  477.     trace var x w traceProc
  478.     set x 22
  479.     set info
  480. } {x {} w}
  481. test trace-10.6 {creating variable when setting variable traces} {
  482.     catch {unset x}
  483.     set info {}
  484.     trace var x w traceProc
  485.     set x(0) 22
  486.     set info
  487. } {x 0 w}
  488. test trace-10.7 {errors when setting variable traces} {
  489.     catch {unset x}
  490.     set x 44
  491.     list [catch {trace var x(0) w traceProc} msg] $msg
  492. } {1 {variable isn't array}}
  493.  
  494. # Check deleting one trace from another.
  495.  
  496. test trace-11.1 {delete one trace from another} {
  497.     proc delTraces {args} {
  498.     global x
  499.     trace vdel x r {traceTag 2}
  500.     trace vdel x r {traceTag 3}
  501.     trace vdel x r {traceTag 4}
  502.     }
  503.     catch {unset x}
  504.     set x 44
  505.     set info {}
  506.     trace var x r {traceTag 1}
  507.     trace var x r {traceTag 2}
  508.     trace var x r {traceTag 3}
  509.     trace var x r {traceTag 4}
  510.     trace var x r delTraces 
  511.     trace var x r {traceTag 5}
  512.     set x
  513.     set info
  514. } {5 1}
  515.  
  516. # Check operation and syntax of "trace" command.
  517.  
  518. test trace-12.1 {trace command (overall)} {
  519.     list [catch {trace} msg] $msg
  520. } {1 {too few args: should be "trace option [arg arg ...]"}}
  521. test trace-12.2 {trace command (overall)} {
  522.     list [catch {trace gorp} msg] $msg
  523. } {1 {bad option "gorp": should be variable, vdelete, or vinfo}}
  524. test trace-12.3 {trace command ("variable" option)} {
  525.     list [catch {trace variable x y} msg] $msg
  526. } {1 {wrong # args: should be "trace variable name ops command"}}
  527. test trace-12.4 {trace command ("variable" option)} {
  528.     list [catch {trace var x y z z2} msg] $msg
  529. } {1 {wrong # args: should be "trace variable name ops command"}}
  530. test trace-12.5 {trace command ("variable" option)} {
  531.     list [catch {trace var x y z} msg] $msg
  532. } {1 {bad operations "y": should be one or more of rwu}}
  533. test trace-12.6 {trace command ("vdelete" option)} {
  534.     list [catch {trace vdelete x y} msg] $msg
  535. } {1 {wrong # args: should be "trace vdelete name ops command"}}
  536. test trace-12.7 {trace command ("vdelete" option)} {
  537.     list [catch {trace vdelete x y z foo} msg] $msg
  538. } {1 {wrong # args: should be "trace vdelete name ops command"}}
  539. test trace-12.8 {trace command ("vdelete" option)} {
  540.     list [catch {trace vdelete x y z} msg] $msg
  541. } {1 {bad operations "y": should be one or more of rwu}}
  542. test trace-12.9 {trace command ("vdelete" option)} {
  543.     catch {unset x}
  544.     set info {}
  545.     trace var x w traceProc
  546.     trace vdelete x w traceProc
  547. } {}
  548. test trace-12.10 {trace command ("vdelete" option)} {
  549.     catch {unset x}
  550.     set info {}
  551.     trace var x w traceProc
  552.     trace vdelete x w traceProc
  553.     set x 12345
  554.     set info
  555. } {}
  556. test trace-12.11 {trace command ("vdelete" option)} {
  557.     catch {unset x}
  558.     set info {}
  559.     trace var x w {traceTag 1}
  560.     trace var x w traceProc
  561.     trace var x w {traceTag 2}
  562.     set x yy
  563.     trace vdelete x w traceProc
  564.     set x 12345
  565.     trace vdelete x w {traceTag 1}
  566.     set x foo
  567.     trace vdelete x w {traceTag 2}
  568.     set x gorp
  569.     set info
  570. } {2 x {} w 1 2 1 2}
  571. test trace-12.12 {trace command ("vdelete" option)} {
  572.     catch {unset x}
  573.     set info {}
  574.     trace var x w {traceTag 1}
  575.     trace vdelete x w non_existent
  576.     set x 12345
  577.     set info
  578. } {1}
  579. test trace-12.13 {trace command ("vinfo" option)} {
  580.     list [catch {trace vinfo} msg] $msg]
  581. } {1 {wrong # args: should be "trace vinfo name"]}}
  582. test trace-12.14 {trace command ("vinfo" option)} {
  583.     list [catch {trace vinfo x y} msg] $msg]
  584. } {1 {wrong # args: should be "trace vinfo name"]}}
  585. test trace-12.15 {trace command ("vinfo" option)} {
  586.     catch {unset x}
  587.     trace var x w {traceTag 1}
  588.     trace var x w traceProc
  589.     trace var x w {traceTag 2}
  590.     trace vinfo x
  591. } {{w {traceTag 2}} {w traceProc} {w {traceTag 1}}}
  592. test trace-12.16 {trace command ("vinfo" option)} {
  593.     catch {unset x}
  594.     trace vinfo x
  595. } {}
  596. test trace-12.17 {trace command ("vinfo" option)} {
  597.     catch {unset x}
  598.     trace vinfo x(0)
  599. } {}
  600. test trace-12.18 {trace command ("vinfo" option)} {
  601.     catch {unset x}
  602.     set x 44
  603.     trace vinfo x(0)
  604. } {}
  605. test trace-12.19 {trace command ("vinfo" option)} {
  606.     catch {unset x}
  607.     set x 44
  608.     trace var x w {traceTag 1}
  609.     proc check {} {global x; trace vinfo x}
  610.     check
  611. } {{w {traceTag 1}}}
  612.  
  613. # Check fancy trace commands (long ones, weird arguments, etc.)
  614.  
  615. test trace-13.1 {long trace command} {
  616.     catch {unset x}
  617.     set info {}
  618.     trace var x w {traceTag {This is a very very long argument.  It's \
  619.     designed to test out the facilities of TraceVarProc for dealing \
  620.     with such long arguments by malloc-ing space.  One possibility \
  621.     is that space doesn't get freed properly.  If this happens, then \
  622.     invoking this test over and over again will eventually leak memory.}}
  623.     set x 44
  624.     set info
  625. } {This is a very very long argument.  It's \
  626.     designed to test out the facilities of TraceVarProc for dealing \
  627.     with such long arguments by malloc-ing space.  One possibility \
  628.     is that space doesn't get freed properly.  If this happens, then \
  629.     invoking this test over and over again will eventually leak memory.}
  630. test trace-13.2 {long trace command result to ignore} {
  631.     proc longResult {args} {return "quite a bit of text, designed to
  632.     generate a core leak if this command file is invoked over and over again
  633.     and memory isn't being recycled correctly"}
  634.     catch {unset x}
  635.     trace var x w longResult
  636.     set x 44
  637.     set x 5
  638.     set x abcde
  639. } abcde
  640. test trace-13.3 {special list-handling in trace commands} {
  641.     catch {unset "x y z"}
  642.     set "x y z(a\n\{)" 44
  643.     set info {}
  644.     trace var "x y z(a\n\{)" w traceProc
  645.     set "x y z(a\n\{)" 33
  646.     set info
  647. } "{x y z} a\\n\\{ w"
  648.  
  649. # Check for things that are illegal while a trace is active (such
  650. # as deleting a variable).
  651.  
  652. test trace-14.1 {unsets must be disallowed during traces} {
  653.     catch {unset x}
  654.     set x 123
  655.     set info {}
  656.     trace var x r {traceCheck {global x; unset x}}
  657.     set x
  658.     concat $info [list [catch {set x} msg] $msg]
  659. } {1 {can't unset "x": trace is active on variable} 0 123}
  660. test trace-14.2 {unsets must be disallowed during traces} {
  661.     catch {unset x}
  662.     set x 123
  663.     set info {}
  664.     trace var x r {traceCheck {uplevel {unset x}}}
  665.     set x
  666.     concat $info [list [catch {set x} msg] $msg]
  667. } {1 {can't unset "x": trace is active on variable} 0 123}
  668. test trace-14.3 {unsets must be disallowed during traces} {
  669.     catch {unset x}
  670.     set x(14) 123
  671.     set info {}
  672.     trace var x(14) r {traceCheck {uplevel {unset x}}}
  673.     set x(14)
  674.     concat $info [list [catch {set x(14)} msg] $msg]
  675. } {1 {can't unset "x": trace is active on variable} 0 123}
  676.  
  677. # Check various non-interference between traces and other things.
  678.  
  679. test trace-15.1 {trace doesn't prevent unset errors} {
  680.     catch {unset x}
  681.     set info {}
  682.     trace var x u {traceProc}
  683.     list [catch {unset x} msg] $msg $info
  684. } {1 {can't unset "x": no such variable} {x {} u}}
  685. test trace-15.2 {traced variables must survive procedure exits} {
  686.     catch {unset x}
  687.     proc p1 {} {global x; trace var x w traceProc}
  688.     p1
  689.     trace vinfo x
  690. } {{w traceProc}}
  691. test trace-15.3 {traced variables must survive procedure exits} {
  692.     catch {unset x}
  693.     set info {}
  694.     proc p1 {} {global x; trace var x w traceProc}
  695.     p1
  696.     set x 44
  697.     set info
  698. } {x {} w}
  699.  
  700. # Be sure that procedure frames are released before unset traces
  701. # are invoked.
  702.  
  703. test trace-16.1 {unset traces on procedure returns} {
  704.     proc p1 {x y} {set a 44; p2 14}
  705.     proc p2 {z} {trace var z u {traceCheck {lsort [uplevel {info vars}]}}}
  706.     set info {}
  707.     p1 foo bar
  708.     set info
  709. } {0 {a x y}}
  710.  
  711. # Delete arrays when done, so they can be re-used as scalars
  712. # elsewhere.
  713.  
  714. catch {unset x}
  715. return ""
  716.